home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 6 / FM Towns Free Software Collection 6.iso / ms_dos / check / check101 / check.lib < prev    next >
Text File  |  1993-07-08  |  7KB  |  239 lines
  1. procedure Puts( s:string );
  2.     var regist:registers;
  3.         param:array[1..256] of integer;
  4.         i:byte;
  5.     begin
  6.     s:=s+'$';
  7.     for i:=1 to length( s ) do 
  8.         begin
  9.              MemW[Seg( param ):Ofs( param )+i-1]:=integer(s[i]);
  10.         end;
  11.     regist.ah:=$09;
  12.     regist.ds:=Seg( param );
  13.     regist.dx:=Ofs( param );
  14.     Intr( $21, regist );
  15.     end;
  16.  
  17. {==背景色を変えるルーチン==ここは既に完成==}
  18. {made 92.3.29}
  19. {黒=0;青=1;緑=2;水色=3;赤=4;紫=5;黄色=6;白=7;}
  20. procedure backcolor(iro:byte);
  21. begin
  22.    case iro of 
  23.        0 :puts(#27+'[40m');
  24.        1 :puts(#27+'[44m');
  25.        2 :puts(#27+'[42m');
  26.        3 :puts(#27+'[46m');
  27.        4 :puts(#27+'[41m');
  28.        5 :puts(#27+'[45m');
  29.        6 :puts(#27+'[43m');
  30.        7 :puts(#27+'[47m');
  31.    end;
  32. end;
  33.  
  34. {======文章を空白処理するためのルーチン==ここは既に完成============}
  35. {made 92.3.30}
  36. procedure kuhakusyori(var RK:string);
  37. var
  38.    dammy:string;
  39. begin
  40.    Repeat    {RKの左側が一文字空白であるか調べその空白を削除する}
  41.      If Pos(' ',RK)=1 then delete(RK,1,1);
  42.    until Pos(' ',RK) <> 1;
  43.    Repeat    {RKの右側が一文字空白であるか調べその空白を削除する}
  44.      Dammy:=copy(RK,length(RK),1);
  45.      If Dammy=' ' then delete(RK,length(RK),1);
  46.    until Dammy <> ' ';
  47.    Repeat
  48.      Dammy:=copy(RK,length(RK),1);
  49.      If ((Dammy='.') or (Dammy='?') or (Dammy='!') or (Dammy=':'))
  50.         then insert(' ',RK,length(RK));
  51.    until not ((Dammy='.') AND (Dammy='?') and (Dammy='!') and (Dammy=':'));
  52. end;
  53.  
  54. {======辞書は何を使うかを設定するためのルーチン===ここは既に完成============}
  55. {made 92.3.29}
  56. procedure config(var jisyo1,jisyo2,jisyo3:string);
  57. var
  58.    data:string[255];
  59.    config_file:text;
  60. begin
  61.    assign(config_file,'CHECK.cfg');
  62.    reset(config_file);
  63.    while not Eof(config_file) do
  64.       begin
  65.          readln(config_file,data);
  66.          if copy(data,1,pos('=',data)-1)='JIsyo1'
  67.             then jisyo1:=copy(data,pos('=',data)+1,length(data));
  68.          if copy(data,1,pos('=',data)-1)='JIsyo2'
  69.             then jisyo2:=copy(data,pos('=',data)+1,length(data));
  70.          if copy(data,1,pos('=',data)-1)='JIsyo3'
  71.             then jisyo3:=copy(data,pos('=',data)+1,length(data));
  72.        end;
  73.    close(config_file);
  74. end;
  75.  
  76. {=========タイトル表示ルーチン===ここは既に完成==========================}
  77. {made 92.3.29}
  78. procedure Title;     {コピーライト表示}
  79. begin
  80.     clrscr;
  81.         TextColor(Shiro);
  82.         Write('      －－－－ For All FM-Series');
  83.         Writeln(' 英文翻訳支援プログラムシリーズ －－－－');
  84.     Write('                 －－－ ');
  85.     TextColor(mizuiro);
  86.     Write('ＣＨＥＣＫ．ＥＸＥ　Ver.1.01α');
  87.     TextColor(Shiro);
  88.     Writeln(' －－－');
  89.     WriteLn('                       Programed by H.Nakayasu (c) 1992');
  90.     TextColor(Shiro);
  91. end;
  92.  
  93. {==メモリーが充分かどうかをチェックするルーチン==ここは既に完成==}
  94. {made 92.3.29}
  95. {$f+}
  96. function  HeapFunc(Size: word): integer;
  97. {$f-}
  98. begin
  99.    Writeln(^G+'メモリーが足りません');
  100.    HeapFunc := 1;
  101. end;  { HeapErrorFunc }
  102.  
  103. {====ファイルより文章を切り出すためのルーチン==ここは既に完成================}
  104. {made 92.3.29}
  105. {文章の右側が . ? ! : 改行 になるまで調べて一文としてファイルから切り取る}
  106. procedure CutSTRINGfromDocument(var Document_file:text; var STringLine:string);
  107. var
  108.    ch:char;
  109. begin
  110.    stringline:='';
  111.    repeat
  112.       read(Document_file,ch);
  113.       stringline:=stringline+ch;
  114.    until ((ch='.') or (ch='?') or (ch='!') or 
  115.               (ch=':') or (ch=CrChar));
  116.    Repeat    {stringlineの左側が一文字空白であるか調べその空白を削除する}
  117.      If Pos(' ',stringline)=1 then delete(stringline,1,1);
  118.    until Pos(' ',stringline) <> 1;
  119. end;
  120.  
  121. {======文章より単語を１つ切り出すためのルーチン==ここは既に完成============}
  122. {made 92.3.30}
  123. procedure CutLeftWORDfromSTRINGline(var STringLin,word:string);
  124. var
  125.    ch:string[1];
  126. begin
  127.    Repeat    {STringLineの左側が一文字空白であるか調べその空白を削除する}
  128.      If Pos(' ',STringLin)=1 then delete(STringLin,1,1);
  129.    until Pos(' ',STringLin) <> 1;
  130.    word:='';
  131.    repeat
  132.       ch:=copy(stringlin,1,1);
  133.       delete(stringlin,1,1);
  134.       word:=word+ch;
  135.    until ((ch=' '){ and (ch=CrChar)});
  136.    Repeat    {STringLineの左側が一文字空白であるか調べその空白を削除する}
  137.      If Pos(' ',STringLin)=1 then delete(STringLin,1,1);
  138.    until Pos(' ',STringLin) <> 1;
  139.    If Pos(' ',word)=1 then delete(word,1,1);
  140. end;
  141.  
  142. {===ここはファイルをオープンするためのルーチン==既に完成=================}
  143. {made 92.3.30}
  144. procedure  OpenFile(var filename:string; var textfile:text; var flag:integer);
  145. begin
  146. {   if Pos('.',FileName) = 0 then  FileName := FileName+'.txt';}
  147.    Assign(TextFile,FileName);
  148.    {$i-}  Reset(TextFile);  {$i+}
  149.    if IOResult <> 0 then
  150.       begin
  151.         textcolor(aka);
  152.         Writeln(^G,'ファイルが存在しません');
  153.         textcolor(shiro);
  154.         if IOResult <> 0 then flag:=1;
  155.       end
  156.      else flag:=0;{if}
  157. end;  { OpenFile }
  158.  
  159. {===指定した辞書の中から単語を検索するためのルーチン==既に完成===========}
  160. {made 92.3.30}
  161. procedure SearchWordfromDIC(var jisyo:string;
  162.                             var Searchword:string;
  163.                             var return:string);
  164. var
  165.     dicFile: text;
  166.     Line: string;
  167. begin
  168.    assign(dicFile,jisyo);
  169.    reset(dicFile);
  170.    repeat
  171.       Readln(dicFile, Line);
  172.       kuhakusyori(line);
  173.       if Searchword=line then return:=line else return:='';
  174.    until (eof(dicfile) or (Searchword=line));
  175.    close(dicfile);
  176. end;
  177.  
  178.  
  179. {===ファイルに新しくデータを追加するためのルーチン====既に完成===========}
  180. {made 92.3.30}
  181. procedure DataPlus2File(var filename:string; var word:string);
  182. var textfile:text;
  183. begin
  184.    Assign(TextFile,FileName);
  185.    Append(TextFile);
  186.    writeln(textfile,word);
  187.    flush(textfile);
  188.    close(textfile);
  189. end;
  190.  
  191. {===ファイルの存在を確認するためのルーチン====既に完成===========}
  192. {made 92.3.30}{1:無かったら新規作成 2:無かったら終了 3:あっても新規作成}
  193. procedure CheckFileExist(i:integer; filename:string);
  194. var textfile:text;
  195. begin
  196.    Assign(TextFile,FileName);
  197.    {$i-}  Reset(TextFile);  {$i+}
  198.    if IOResult <> 0 then
  199.       begin
  200.         case i of
  201.            1:begin
  202.                 rewrite(TextFile);
  203.                 textcolor(aka);
  204.                 Writeln(^G,'ファイルが存在しなかったので新規作成しました');
  205.                 textcolor(shiro);
  206.                 flush(textfile);
  207.                 close(textfile);
  208.              end;
  209.            2:begin
  210.                 rewrite(TextFile);
  211.                 textcolor(aka);
  212.                 Writeln(^G,'ファイルが存在しません');
  213.                 textcolor(shiro);
  214.                 close(textfile);
  215.                 halt;
  216.              end;
  217.         end;
  218.       end;
  219.    if ((IOResult=0) and (i=3)) then
  220.       begin
  221.          rewrite(TextFile);
  222.          textcolor(aka);
  223.          writeln(filename,'の中身を空にしました');
  224.          textcolor(shiro);
  225.          flush(textfile);
  226.          close(textfile);
  227.       end;
  228. end;
  229.  
  230. procedure line;
  231. var i:integer;
  232. begin
  233.    textcolor(midori);
  234.    for i:=1 to 80 do
  235.      write('-');
  236.    textcolor(shiro);
  237. end;
  238.  
  239.